//////////
// 定义设置清理：lambda/define/set/gensym/oblist/gc

#include <string.h>
#include <limits.h>
#include "../basic/operator.h"

Cell* op_lambda(Scheme *sc) {
	sc->returnValue = make_closure(sc, sc->returnValue, sc->env);
	return pop_callstack(sc);
}

/*
// (get-closure-code closure)
Cell* op_get_closure(Scheme *sc) {
	sc->args = first(sc->args);
	if (sc->args == &g_nil) {
		return s_return_helper(sc, &g_false);
	} else if (type_of(sc->args, CLOSURE_TYPE)) {
		return s_return_helper(sc, cons(sc, sc->sym_lambda, car(sc->args)));
		//s_return_helper(sc, cons(sc, sc->sym_lambda, closure_code(sc->args)));
	} else {
		return s_return_helper(sc, &g_false);
	}
}
*/

//TODO
// -- (define Class Circle (radias Number) (make-circle) (draw move area))
// -- (define Method area Circle () (* *PI* radias radias))
// -- (define Constructor make-circle Circle (radias) (set! (this radias) radias))
// -- (define Procedure add5 (lambda (x) (+ x 5)))
// -- (define Procedure (add6 x) (+ x 6))
// -- (define Circle circle (make-circle 10))
// (define add5 (lambda (x) (+ x 5)))
// (define (add6 x) (+ x 6))
// (define circle (make-circle 10))
Cell* op_def0(Scheme *sc) {
	//(define var_name expr)
	Cell *x;

	if (is_immutable(car(sc->code))) {
		sc->returnValue = make_default_exception(sc, "UNABLE_TO_ALTER_IMMUTABLE", "define: unable to alter immutable.");
		return pop_callstack(sc);
	}
	if (type_of(sc, car(sc->code), PAIR_TYPE)) {
		//形式1 (define (var_name arg ...) body)
		//例子 (define (fname arg1 arg2) (+arg1 arg2))可以通过这个分支 ，最后结果是闭包 ,这个被变换为 (define fname (lambda (arg1 arg2) (+ arg1 arg2))
		//形式2 (define (var_name . arg) body) //x为(var_name arg ...)  被变换为 (define fname (lambda arg body)
		x = caar(sc->code);
		sc->code = cons(sc, cell_symbol_lambda, cons(sc, cdar(sc->code), cdr(sc->code)));
	} else {
		x = car(sc->code);				//x为var_name
		sc->code = cadr(sc->code);		//sc->code为expr
	}
	TYPE_CHECK(sc, x, SYMBOL_TYPE);

	push_callstack(sc, cell_op_def1, &g_nil, x);
	sc->op = cell_op_eval;
	return &g_true;

	/*
	const char *className = symbol_name(x);
	if (strcmp(className, CLASS_TYPE) == 0) {
		return define_class(sc, sc->code);
	} else if (strcmp(className, METHOD_TYPE) == 0) {
		return define_method(sc, sc->code);
	} else if (strcmp(className, CONSTRUCTOR_TYPE) == 0) {
		return define_constructor(sc, sc->code);
	} else {
		push_callstack(sc, cell_op_def1, &g_nil, x);
		sc->op = cell_op_eval;
		return &g_true;
	}
	*/
}

Cell* op_def1(Scheme *sc) {
	Cell *x;

	//sc->code为var_name
	x = find_slot_in_env(sc, sc->env, sc->code, FALSE);	//在当前环境中查找这个符号，并不是在全局环境中查找，而且不递归查找
	if (x != &g_nil) {
		set_slot_in_env(sc, x, sc->returnValue);
	} else {
		new_slot_in_env(sc, sc->code, sc->returnValue);
	}
	sc->returnValue = sc->code;
	return pop_callstack(sc);				//返回变量名
}


Cell* op_set0(Scheme *sc) {
	//形式 (set! var_name expr)
	Cell* var_name = car(sc->code);
	if (is_immutable(var_name))
		return make_default_exception_1(sc, "UNABLE_TO_ALTER_IMMUTABLE_VARIABLE", "set!: unable to alter immutable variable %s", cell2str(sc, var_name));
	push_callstack(sc, cell_op_set1, &g_nil, var_name);
	sc->code = cadr(sc->code); //sc->code结果为expr
	sc->op = cell_op_eval; //对expr进行求值
	return &g_true;
}

Cell* op_set1(Scheme *sc) {
	Cell *y;

	//sc->code为 var_name
	y = find_slot_in_env(sc, sc->env, sc->code, TRUE);
	if (y != &g_nil) {
		set_slot_in_env(sc, y, sc->returnValue);
		return pop_callstack(sc);
	} else {
		return make_default_exception_1(sc, "UNBOUND_VARIABLE", "set!: unbound variable: %s", cell2str(sc, sc->code));
	}
}

//查找一个符号
static Cell* oblist_find_by_name(Scheme *sc, const char *name) {
	int location = hash_fn(name, sc->globalObjects->_longValue);
	Cell* sym_list;
	for (sym_list = get_vector_item(sc->globalObjects, location); sym_list
			!= &g_nil; sym_list = cdr(sym_list)) {
		char *s = symbol_name(car(sym_list));
		if (strcasecmp(name, s) == 0)
			return car(sym_list); //返回一个符号
	}
	return &g_nil;
}

// 创建一个新的符号
static Cell* oblist_add_by_name(Scheme *sc, const char *name) {
	//符号内部像这样("name1")
	Cell* sym = immutable_cons(sc, make_string(sc, name), &g_nil);
	// (sym)->_flag = T_SYMBOL; //类型为符号
	(sym)->_type = SYMBOL_TYPE;
	set_immutable(car(sym));
	int location = hash_fn(name, sc->globalObjects->_longValue);
	//get_vector_item(sc->oblist, location) 等价于  (vector-ref sc->oblist location)    求值结果是一个符号链表 (symbol ...)
	set_vector_item(sc->globalObjects, location,
			immutable_cons(sc, sym, get_vector_item(sc->globalObjects, location))); //将新的符号加入链表头部
	return sym;
}

//生成一个名字唯一的符号
static Cell* gensym(Scheme *sc) {
	static long s_gensym_cnt = 0;
	for (; s_gensym_cnt < LONG_MAX; s_gensym_cnt++) {
		char name[40];
		snprintf(name, 40, "sgensym-%ld", s_gensym_cnt);
		Cell* sym = oblist_find_by_name(sc, name);
		if (sym != &g_nil)
			continue;
		return oblist_add_by_name(sc, name);
	}
	return &g_nil;
}

// (gensym)
Cell* op_gensym(Scheme *sc) {
	sc->returnValue = gensym(sc);
	return pop_callstack(sc);
}

//返回所有符号的列表
static Cell* oblist_all_symbols(Scheme *sc) {
	Cell* ob_list = &g_nil;
	int i;
	Cell* sym_list;
	for (i = 0; i < sc->globalObjects->_longValue; i++) {
		for (sym_list = get_vector_item(sc->globalObjects, i); sym_list != &g_nil; sym_list
				= cdr(sym_list)) {
			ob_list = cons(sc, car(sym_list), ob_list);
		}
	}
	return ob_list;
}

// (oblist)
Cell* op_oblist(Scheme *sc) {
	sc->returnValue = oblist_all_symbols(sc);
	return pop_callstack(sc);
}


// (gc)
Cell* op_gc(Scheme *sc) {
	gc(sc, &g_nil, &g_nil);
	sc->returnValue = &g_true;
	return pop_callstack(sc);
}

// (gc-verbose #t)
// (gc-verbose)
Cell* op_gcverb(Scheme *sc) {
	//int was = sc->gc_verbose;
	//sc->gc_verbose = (car(sc->args) != &g_false);
	//return s_return_helper(sc, (was) ? &g_true : &g_false);
	return &g_true;
}

void init_define_operators(Scheme *sc) {
	ADD_OPERATOR(sc, "$lambda", lambda);
	ADD_OPERATOR(sc, "$def0", def0);
	ADD_OPERATOR(sc, "$def1", def1);
	ADD_OPERATOR(sc, "$set0", set0);
	ADD_OPERATOR(sc, "$set1", set1);
	ADD_OPERATOR(sc, "gensym", gensym);
	ADD_OPERATOR(sc, "oblist", oblist);
	ADD_OPERATOR(sc, "gc", gc);
	ADD_OPERATOR(sc, "gc-verbose", gcverb);

	ADD_SYNTAX(sc, "lambda", lambda);
	ADD_SYNTAX(sc, "define", def0);
	ADD_SYNTAX(sc, "set!", set0);
}
